home *** CD-ROM | disk | FTP | other *** search
/ Network Support Library / RoseWare - Network Support Library.iso / apidev / pwdchk.arc / PW_DAYS.PAS < prev   
Pascal/Delphi Source File  |  1989-08-08  |  8KB  |  211 lines
  1. {****************************************************************************}
  2. { program PW_Days.PAS.                      Turbo Pascal Version 5.0 Version }
  3. { CopyRight 1989 by Donald C. Williams.  All rights reserved.                }
  4. {****************************************************************************}
  5. program DaysUntilPasswordExpires;
  6. Uses Dos;
  7. type
  8.   ch7                     = array[1..7] of char;
  9.   ch48                    = array[1..48] of char;
  10.   ch70                    = array[1..70] of char;
  11.   ch128                   = array[1..128] of char;
  12.   st15                    = string[15];
  13.   st47                    = string[47];
  14.   GetConnectionInfoReqRec = record
  15.                               RequestLength : word;
  16.                               ReqFunction   : byte;
  17.                               Connection    : byte;
  18.                             end;
  19.   GetConnectionInfoRepRec = record
  20.                               ReturnLength  : word;
  21.                               ObjectID      : longint;
  22.                               ObjectType    : word;
  23.                               ObjectName    : ch48;
  24.                               LoginTime     : ch7
  25.                             end;
  26.   ReadPropertyValueReqRec = record
  27.                               case integer of
  28.                                 0 :( RequestLength : word;
  29.                                      ReqFunction   : byte;
  30.                                      ObjectType    : word;
  31.                                      ObjectName    : st47;
  32.                                      SegNumber     : byte;
  33.                                      PropertyName  : st15;);
  34.                                 1 :( entire        : ch70);
  35.                             end;
  36.   ReadPropertyValueRepRec = record
  37.                               ReturnLength  : word;
  38.                               PropertyValue : ch128;
  39.                               MoreSegments  : byte;
  40.                               PropertyFlags : byte;
  41.                             end;
  42. var
  43.   ConnectionRec           : GetConnectionInfoRepRec;
  44.   Days                    : real;
  45.   bell                    : boolean;
  46. {****************************************************************************}
  47. {                       general functions / procedures                       }
  48. {****************************************************************************}
  49. function int_lohi(original:integer):integer;
  50.   begin
  51.     int_lohi:=(lo(original) * 256) + hi(original);
  52.   end;                                     { function int_lohi               }
  53. {****************************************************************************}
  54. function word_lohi(original:word):word;
  55.   begin
  56.     word_lohi:=(lo(original) * 256) + hi(original);
  57.   end;                                     { function word_lohi              }
  58. {****************************************************************************}
  59. function SwapLong( InInt : longint) : longint;
  60. var char4 : array[1..4] of char;
  61.     i     : integer;
  62. begin
  63.   for i := 1 to 4 do
  64.     begin
  65.       char4[i] := #0;
  66.       char4[i] := chr(mem[seg(InInt) : ofs(InInt) + (i - 1)]);
  67.     end;  { FOR }
  68.   SwapLong :=                   ord(char4[4])  +
  69.             (             256 * ord(char4[3])) +
  70.             (       256 * 256 * ord(char4[1])) +
  71.             ( 256 * 256 * 256 * ord(char4[2]));
  72. end;                                       { function SwapLong               }
  73. {****************************************************************************}
  74. procedure KillNull( var InStr : st47 );
  75. var i : integer;
  76. begin
  77.   i := pos(#0,InStr);
  78.   while i > 0 do
  79.     begin
  80.       delete(InStr,i,1);
  81.       i := pos(#0,InStr);
  82.     end;  { while }
  83. end;                                       { procedure KillNull              }
  84. {****************************************************************************}
  85. function Julian( year : integer; mon, day : byte): real;
  86. var
  87.   temp        : real;
  88. begin                                      { function Julian                 }
  89.   if (year < 0) OR (mon < 1) OR (day < 1) OR (day > 31) then
  90.     begin
  91.       Julian := -1;
  92.       exit;
  93.     end;  { IF }
  94.   if year < 100 then
  95.     year := year + 1900;
  96.   temp := int((mon - 14.0) / 12.0);
  97.   Julian := day - 32075.0 +
  98.             int(1461.0 * (year + 4800.0 + temp) / 4.0) +
  99.             int(367.0 * (mon - 2.0 - temp * 12.0) / 12.0) -
  100.             int(3.0 * int((year + 4900.0 + temp) / 100.0) / 4.0)
  101. end;                                       { function Julian                 }
  102. {****************************************************************************}
  103. procedure JulToYMD( JulianDay : real;
  104.                      var year : integer;
  105.                      var mon, day : byte);
  106. var
  107.   TempA       ,
  108.   TempB       : real;
  109. begin
  110.   TempA := JulianDay + 68569.0;
  111.   TempB := int(4.0 * TempA / 146097.0);
  112.   TempA := TempA - int((146097.0 * TempB + 3.0) / 4.0);
  113.   year  := trunc(4000.0 * (TempA + 1.0) / 1461001.0);
  114.   TempA := TempA - int(1461.0 * year / 4.0) + 31.0;
  115.   mon   := trunc(80.0 * TempA / 2447.0);
  116.   day   := trunc(TempA - int(2447.0 * mon / 80.0));
  117.   TempA := int(mon / 11.0);
  118.   mon   := trunc(mon + 2.0 - 12.0 * TempA);
  119.   year  := trunc(100.0 * (TempB - 49.0) + year + TempA);
  120. end;
  121. {****************************************************************************}
  122. function GetConnectionNumber : byte;
  123. var regs : registers;
  124. begin
  125.   regs.AH := $DC;
  126.   MsDos(regs);
  127.   GetConnectionNumber := regs.AL;
  128. end;                                       { function GetConnectionNumber    }
  129. {****************************************************************************}
  130. procedure GetConnectionInfo( var reply : GetConnectionInfoRepRec );
  131. var regs : registers;
  132.     request : GetConnectionInfoReqRec;
  133. begin
  134.   request.RequestLength := 4;
  135.   request.ReqFunction   := $16;
  136.   request.Connection := GetConnectionNumber;
  137.   reply.ReturnLength    := 63;
  138.   regs.AH := $E3;
  139.   regs.DS := seg(request);
  140.   regs.SI := ofs(request);
  141.   regs.ES := seg(reply);
  142.   regs.DI := ofs(reply);
  143.   MsDos(regs);
  144. end;                                       { procedure GetConnectionInfo     }
  145. {****************************************************************************}
  146. function GetDays(InRec : GetConnectionInfoRepRec) : real;
  147. var regs : registers;
  148.     temp    : array[1..70] of char;
  149.     request : ReadPropertyValueReqRec;
  150.     reply   : ReadPropertyValueRepRec;
  151.     i,j     : integer;
  152.     SysYear : word;
  153.     SysMon  : word;
  154.     SysDay  : word;
  155.     SysDOW  : word;
  156.     PWYear  : integer;
  157.     PWMon   : integer;
  158.     PWDay   : integer;
  159. begin
  160.   request.RequestLength := 70;             { build request packet            }
  161.   request.ReqFunction := $3D;
  162.   request.ObjectType := word_lohi(1);
  163.   request.ObjectName := InRec.ObjectName;
  164.   KillNull(request.ObjectName);
  165.   request.SegNumber := $01;
  166.   request.PropertyName := 'LOGIN_CONTROL';
  167.   reply.ReturnLength := 132;
  168.   for i := 1 to 70 do temp[i] := #0;       { deal with pascal strings        }
  169.   for i := 1 to 6 do temp[i] := request.entire[i];
  170.   for i := 1 to ord(request.ObjectName[0]) do
  171.     temp[6+i] := request.ObjectName[i];
  172.   j := 6 + ord(request.ObjectName[0]);
  173.   for i := 54 to 70 do
  174.     begin
  175.       j := j + 1;
  176.       temp[j] := request.entire[i];
  177.     end;  { for }
  178.   regs.AH := $E3;                          { make the call                   }
  179.   regs.DS := seg(temp);
  180.   regs.SI := ofs(temp);
  181.   regs.ES := seg(reply);
  182.   regs.DI := ofs(reply);
  183.   MsDos(regs);
  184.   if regs.AL = 0 then
  185.     begin
  186.       PWYear := ord(reply.PropertyValue[5]);
  187.       PWMon  := ord(reply.PropertyValue[6]);
  188.       PWDay  := ord(reply.PropertyValue[7]);
  189.       GetDate(SysYear,SysMon,SysDay,SysDOW);
  190.       GetDays := ( Julian(PWYear,PWMon,PWDay) -
  191.                    Julian(SysYear,SysMon,SysDay));
  192.     end  { if }
  193.   else
  194.     begin
  195.       write(regs.AL:3);
  196.       readln;
  197.     end;  { else }
  198. end;                                       { function GetDays                }
  199. {****************************************************************************}
  200. begin
  201.   bell := (paramcount > 0) and ((pos('/B',paramstr(1)) > 0) or
  202.                                 (pos('/b',paramstr(1)) > 0));
  203.   GetConnectionInfo(ConnectionRec);
  204.   Days := GetDays(ConnectionRec);
  205.   if days < 11.0 then
  206.     begin
  207.       if bell then write(#7);
  208.         writeln('Your Password Expires in ',Days:3:0,' days.');
  209.     end;  { if }
  210. end.
  211.